private import base;
private import strings;
private import compute;
private import validate;

contract speech over %t determines (%u,%%a) where execution over %%a is {
  _query has type for all %s such that (%t,(%u)=>%s,()=>quoted,()=>hash of (string,any))=>%%a of %s;
  _request has type (%t,action(%u),()=>quoted,()=>hash of (string,any)) => %%a of ();
  _notify has type (%t,action(%u)) => %%a of ();
};

implementation speech over actor of %t determines (%t,action) is {
  _query(act0r(Ac),Qf,_,_) is action { valis Qf(Ac)};
  _query(nonActor,_,_,_) is action{ raise "cannot query nonActor"};
  _request(act0r(Ac),Rf,_,_) is action{ Rf(Ac) };
  _request(nonActor,_,_,_) is action{};
  _notify(act0r(Ac),Np) is action{ Np(Ac) };
  _notify(nonActor,_) is action{};
};

type actor of %t is act0r(%t) or nonActor;

type stream of %t is alias of action(%t);

#prefix((notify),1100);
#prefix((query),1000);
#prefix((request),1050);

-- _notify speech action
# notify ?Ag with ?Exp on identifier :: action :- Exp::expression :& Ag::expression;
# notify ?A with ?E on ?C ==> perform _notify(A,(procedure(#$"XX") do C(E) using #$"XX"'s C));

-- _query speech action
# query ?Ag with ?Exp :: expression :- Ag::agentExpression :& Exp::expression;
# ?A 's ?S :: agentExpression :- A::expression :& S :: importSelection;
# ?A :: agentExpression :- A::expression;

# freeVarMap(?Exp) ==> freeVarMap(Exp,());
# freeVarMap(?Exp,?XX) ==> formHash(__find_free(Exp,XX,comma,())) ## {
  #formHash(()) ==> hash of {};
  #formHash(?E) ==> hash of {hashEntries(E)};
  #hashEntries(comma(?V,())) ==> $$V->#(V cast any)#;
  #hashEntries(comma(?V,?T)) ==> #($$V->#(V cast any)#;hashEntries(T))#;
};

#fold(?L and ?R,?F,?I) ==> fold(L,F,#*fold(R,F,I));
#fold(?L or ?R,?F,?I) ==> fold(L,F,#*fold(R,F,I));
#fold(?L implies ?R,?F,?I)  ==> fold(L,F,#*fold(R,F,I));
#fold(?L otherwise ?R,?F,?I) ==> fold(L,F,#*fold(R,F,I));
#fold(not ?N,?F,?I) ==> fold(N,F,I);
#fold(?T,?F,?I) ==> F(T,I);

#freePtn(?P in ?C,?I) ==> __find_free(P,I,comma,I);
#freePtn(?V matches ?P,?I) ==> __find_free(P,I,comma,I);
#freePtn(?X,?I) ==> I;
 
#queryDefined(?L order by ?C,?Ex) ==> queryDefined(L,Ex);
#queryDefined(unique ?C of ?E where ?Q,?Ex) ==> fold(Q,freePtn,Ex);
#queryDefined(unique ?E where ?Q,?Ex) ==> fold(Q,freePtn,Ex);
#queryDefined(all ?E where ?Q,?Ex) ==> fold(Q,freePtn,Ex);
#queryDefined(#(anyof ?E where ?Q default ?D)#,?Ex) ==> fold(Q,freePtn,Ex);
#queryDefined(anyof ?E where ?Q,?Ex) ==> fold(Q,freePtn,Ex);
#queryDefined(?C of ?E where ?Q,?Ex) ==> fold(Q,freePtn,Ex);
#queryDefined(?T of ?C of {?E where ?Q},?Ex) ==> fold(Q,freePtn,Ex);
#queryDefined(?T of {?Q},?Ex) ==> queryDefined(Q,Ex);
#queryDefined(?Q,?Ex) ==> Ex;

#queryFree(?Q,?Ex) ==> freeVarMap(Q,#*queryDefined(Q,Ex));  

#query ?A's ?Ex with ?E ==> valof _query(A,(function(#$"XX") is E using #$"XX"'s Ex),(function() is quote(E)),(function() is queryFree(E,Ex)));
#query ?A with ?E ==> valof _query(A,(function(#$"XX") is let { open #$"XX" } in E),(function() is quote(E)),(function() is queryFree(E,())));

-- _request speech actions  
#request ?Ag to ?Act :: action :- Act::action :& Ag::agentExpression;

#request ?A to extend ?Tgt with ?Exp  ==>
        perform _request(A,(procedure(#$"XX") do {#(#$"XX")#.Tgt := _extend(#(#$"XX")#.Tgt,Exp)}),(function() is <|extend ?Tgt with ?Exp|>),(function() is freeVarMap(Exp)));
#request ?A to merge ?Tgt with ?Exp  ==>
        perform _request(A,(procedure(#$"XX") do {#(#$"XX")#.Tgt := _merge(#(#$"XX")#.Tgt,Exp)}),(function() is <|merge ?Tgt with ?Exp|>),(function() is freeVarMap(Exp)));
#request ?A to delete ?Ptn in ?Tgt  ==>
        perform _request(A,(procedure(#$"XX") do {#(#$"XX")#.Tgt := _delete(#(#$"XX")#.Tgt,(pattern() from Ptn))}),(function() is <|delete ?Ptn in ?Tgt|>),(function() is hash{}));
#request ?A to update ?Ptn in ?Tgt with ?Exp  ==>
        perform _request(A,(procedure(#$"XX") do {#(#$"XX")#.Tgt := _update(#(#$"XX")#.Tgt,(pattern() from Ptn), (function(Ptn) is Exp))}),(function() is <|update ?Ptn in ?Tgt with ?Exp|>),(function() is freeVarMap(Exp,Ptn)));

#request ?A's ?Ex to ?Act  ==> perform _request(A,(procedure(#$"XX") do {Act using #$"XX"'s Ex}),(function() is quote(Act)),(function() is freeVarMap(Act,Ex)));
#request ?A to ?Act ==> perform _request(A,(procedure(#$"XX") do {let{ open #$"XX" } in Act}),(function() is quote(Act)),(function() is freeVarMap(Act,())));

-- event rules
# on ?E do ?A :: statement :-  A :: action :& E::eventCondition ## {
  # ?P on identifier :: eventCondition:- P::pattern;
  # ?P on identifier where ?Cond :: eventCondition :- P::pattern :& Cond::condition;
};

-- manage the transformation of actors
#actor{?Defs} :: expression :- Defs ;* statement;

#actor {?Defs} ==> act0r({actorTheta(Defs)});

-- collect all event rules from the theta environment
#glom(?AA,?BB) ==> glm(AA,BB) ## {
  glm(A,<|()|>) is A;
  glm(<|()|>,A) is A;
  glm(<|?L;?R|>,A) is <|?L;glm(?R,?A)|>;
  glm(A,B) is <|?A;?B|>;
};

#actorTheta(?Defs) ==> buildActorTheta(collEvtRules(Defs,((),()))) ## {
  #buildActorTheta((?Others,?Rules)) ==> actorRules(#*sortRules(Rules,()),Others);
  
  #collEvtRules(#(on ?Evt do ?Act )#, (?Theta, ?EvtRules)) ==> (Theta,glom(EvtRules,#*eventRule(#(on Evt do Act)#)));
  #collEvtRules(#(?L;?R)#,?EvtRules) ==> collEvtRules(R,#*collEvtRules(L,EvtRules));
  #collEvtRules(#(?L;)#,?EvtRules) ==> collEvtRules(L,EvtRules);
  #collEvtRules(?Stmt, (?Theta, ?EvtRules)) ==> (glom(Theta,Stmt),EvtRules);

  -- pick apart an event condition into individual pieces
  #eventRule(#(on ?P on ?Ch where ?C do ?A)#) ==> eRule(Ch,P,C,A);
  #eventRule(#(on ?P on ?Ch do ?A)#) ==> eRule(Ch,P,true,A);

  -- sort all rules into channels
  #sortRules(#(?L;?R)#,?Groups) ==> sortRules(R,#*sortRules(L,Groups));
  #sortRules(eRule(?Ch,?P,?C,?A),?Groups) ==> sortRule(eRule(Ch,P,C,A),Ch,Groups);
  #sortRules((),()) ==> ();
 
  -- sort rules by channel
  #sortRule(?Rl,?Ch,((?Ch,?Rls),?More)) ==> ((Ch,(Rl,Rls)),More);
  #sortRule(?Rl,?Ch,(?Group,?More)) ==> (Group, sortRule(Rl,Ch,More));
  #sortRule(?Rl,?Ch,()) ==> ((Ch,Rl),());
  
  -- collect all event rules from the theta environment
  #glom(?AA,?BB) ==> glm(#*AA,#*BB) ## {
    #glm(?A,()) ==> A;
    #glm((),?A) ==> A;
    #glm(#(?L;?R)#,?A) ==> #(L;glm(R,A))#;
    #glm(?A,?B) ==> #(A;B)#;
  };
  
  #actorRules(?Channels,?Othrs) ==> makeRules(Channels,Othrs) ## {
    -- make eca rules from sorted groups
    #makeRules(((?Ch,?Rules),?More),?Others) ==>  makeRules(More,glom(#*makeEcaProc(Ch,channelProc(Rules, #$"evt"),#$"evt"),Others));
    #makeRules((?Ch,?Rules),()) ==> makeEcaProc(Ch,channelProc(Rules, #$"evt"),#$"evt");
    #makeRules((?Ch,?Rules),?Others) ==> glom(#*makeEcaProc(Ch,channelProc(Rules, #$"evt"),#$"evt"),Others);
    #makeRules((),?Others) ==> Others;

    -- construct the channel procedure
    #channelProc((?Rl,?More),?Evt) ==> mergeProcs(#*chnlProc(Rl,Evt),#*channelProc(More,Evt));
    #channelProc(?Rl,?Evt) ==> chnlProc(Rl,Evt);

    #mergeProcs((?L1, ?R1),(?L2, ?R2)) ==> (glom(L1,L2), glom(R1,R2));

    #chnlProc(eRule(?Ch,?P,?C,?A),?Evt) ==> (#( #(#$"eca")#(P) where C do A)#, #(#$"eca")#(Evt));

    #makeEcaProc(?Ch, (?Dfs, ?Calls), ?Evt) ==> #( Ch(Evt) do {Calls} using { Dfs } )#;
  }
}